VBA在Excel中的应用（一）

目录

ActiveCell
ActiveWorkbook
AdvancedFilter
AutoFill

ActiveCell

1. 1. 检查活动单元格是否存在
   
   Sub activeCell()
       If ActiveCell Is   Nothing   Then   End If
   End Sub
2. 2. 通过指定偏移量设置活动单元格
   
   Sub offset()
       ActiveCell.Offset(RowOffset: =- 2 , ColumnOffset: = 4 ).Activate
   End Sub
   Offset函数的第一个参数为Row的偏移量，第二个参数为Column的偏移量（可以不指定），使用时可以直接给定值，如Offset(2, 4)。值小于0向相反方向偏移。Offset().Activate与Offset().Select在效果上等同。
3. 3. 设置活动单元格的当前值
   
   Sub SetValue
      ActiveCell.Value =   " Hello World! "
   End Sub
4. 4. 为当前活动单元格设置公式
   
   Sub fomula()
       ActiveCell.Formula =   " =SUM($G$12:$G$22) "
   End Sub
   将公式的表达式直接赋值给Formula属性，公式表达式可以参考Excel中的公式菜单，如求和、计数、求平均值等。
5. 5. 获取当前活动单元格的地址
   
   Sub selectRange()
       MsgBox ActiveCell.Address
   End Sub
   地址的格式如：$A$11。
6. 6. 获取从当前活动单元格开始到边界单元格的区域
   ' 从当前单元格到最顶端
   Sub SelectUp()
       Range(ActiveCell, ActiveCell.End(xlUp)).Select
   End Sub
   ' 从当前单元格到最底端
   Sub SelectDown()
       Range(ActiveCell, ActiveCell.End(xlDown)).Select
   End Sub
   ' 从当前单元格到最右端（等同于xlEnd）
   Sub SelectToRight()
       Range(ActiveCell, ActiveCell.End(xlToRight)).Select
   End Sub
   ' 从当前单元格到最左端
   Sub SelectToLeft()
       Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
   End Sub
   
7. 7. 当前活动单元格所在区域选择 
   
   Sub SelectCurrentRegion()
       ActiveCell.CurrentRegion.Select
   End Sub
   对CurrentRegion属性所代表的区域的说明：
   CurrentRegion返回活动单元格所在的周围由空行和空列组成的单元格区域（这个似乎有点不太好理解） ，可以看下图的示例：
   可以这样理解CurrentRegion属性所代表的区域，即以活动单元格为中心，它所包含的矩形区域的每一行和每一列中至少包含有一个数据，上图中的蓝色阴影区域中，无论活动单元格是哪一个，其所在的当前区域均为同一区域，如B5:D7区域中的B5和C6单元格。A4的当前区域表示为A1:D7，A8的当前区域表示为A5:D11，A12的当前区域只有它本身。
   使用CurrentRegion属性相当于在Excel工作表中选择菜单“编辑-定位”命令，在弹出的“定位”对话框中单击“定位条件”按钮，然后在“定位条件”对话框中选中“当前区域”选项按钮，或者相当于使用Ctrl+Shift+*组合键。在Excel2007中，该命令在以下地方可以找到：
   在下拉菜单中选择“Go To Special…” ，在对话框中选择“Current region”。
   有关使用CurrentRegion的一些例子：
    在下图中，要使用空白单元格上方的有数据的单元格中的数据来填充空白单元格。
   
   代码如下，
   Sub FillBlankCells()
       Worksheets( " sheet1 " ).Range( " A1 " ).CurrentRegion.SpecialCells(xlCellTypeBlanks).FormulaR1C1 =   " =R[-1]C "
       Worksheets( " sheet1 " ).Range( " A1 " ).CurrentRegion.Value = Worksheets( " sheet1 " ).Range( " A1 " ).CurrentRegion.Value
   End Sub
   执行之后，工作表中单元格A1所在当前区域中的空白单元格被相应数据填充，如下图。
    
   ‚ 如下图，对第三列进行降序排序。
    
   代码如下：
   Sub testSort()
       Dim rng As Range
       Set rng = Worksheets( " sheet1 " ).Cells( 1 , 1 ).CurrentRegion
       rng.Sort Key1: = rng.Cells( 1 , 3 ), Order1: = xlDescending, Header: = xlYes
   End Sub
   执行之后，工作表中的数据将按照第三列的数据降序排序，如下图。
    
8. 8. 使用SpecialCells方法
   该方法用于返回与指定形态和值相符合的所有单元格，其中第一个参数为xlCellType类型所代表的常数。

   xlCellTypeAllFormatConditions	任何格式的单元格。
   xlCellTypeAllValidation	带数据校验的单元格。
   xlCellTypeBlanks	空单元格。
   xlCellTypeComments	包含注释的单元格。
   xlCellTypeConstants	包含常数的单元格。
   xlCellTypeFormulas	包含公式的单元格。
   xlCellTypeLastCell	已用范围的最后一个单元格。
   xlCellTypeSameFormatConditions	有相同格式的单元格。
   xlCellTypeSameValidation	有相同数据校验准则的单元格。
   xlCellTypeVisible	所有可见单元格。

   第二个参数为可选参数。如果xlCellType为xlCellTypeConstants或xlCellTypeFormulas 之一，该参数用于确定结果中应包含哪些类型的单元格。将某几个值相加可使此方法返回多种形态的单元格。默认情况下将指定所有常数或公式，对其形态则不加类型。它可以是下列常数之一。
   xlErrors
   xlLogical
   xlNumbers
   xlTextValues
   
   Sub SelectActiveArea()
       Range(Range( " A1 " ), ActiveCell.SpecialCells(xlTypeLastCell)).Select
   End Sub
   有关使用SpecialCells的一个例子：
   将下图所示的数据按顺序存放到一个新建的工作表中，
    
   Sub toAcol()
       Dim newSht As Worksheet
       Dim Rng As Range
       Dim allDat As Range
       Dim pt As Range
       Dim i As   Long
       ' 选择工作表中所有有内容的单元格
       Set allDat = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
       ' 新增工作表
       Set newSht = Worksheets.Add
       ' 设置新工作表中的起始位置
       Set pt = newSht.Range( " a1 " )
       For   Each Rng In allDat.Areas
           For i =   1   To Rng.Cells.Count
               pt = Rng.Cells(i)
               Set pt = pt.Offset( 1 , 0 )
           Next
       Next
       ' 重命名新工作表
       newSht.Name =   " newSht "   & Worksheets.Count
   End Sub
   执行后，在名称为“newSht4”的工作表中会出现如下图所示的数据。
   
9. 9. 通过Application.WorksheetFunction调用Proper方法
   
   Sub FixText()
           ActiveCell.Value = Application.WorksheetFunction.Proper( " asdf " )
   End Sub
   该方法将给定的表达式中的第一个字母大写，而其余字母小写，示例中的代码将活动单元格的值设置为“Asdf”。
10. 10. EntireRow和EntireColumn
    
    Sub SelectColumn()
        ActiveCell.EntireColumn.Select
    End Sub
    Sub SelectRow()
        ActiveCell.EntireRow.Select
    End Sub
    EntireColumn用于选择当前活动单元格所在的整列，EntireRow用于选择当前活动单元格所在的整行。
11. 11. 找出当前所选区域中包含最大值的单元格
    
    Sub GoToMax()
        Dim WorkRange As Range
        If   TypeName (Selection) <>   " Range "   Then   Exit   Sub
    
        If Selection.Count =   1   Then
            Set WorkRange = Cells
        Else
            Set WorkRange = Selection
        End   If
        MaxVal = Application.Max(WorkRange)
        
        On   Error   Resume   Next
        WorkRange.Find(What: = MaxVal, _
            After: = WorkRange.Range( " A1 " ), _
            LookIn: = xlValues, _
            LookAt: = xlPart, _
            SearchOrder: = xlByRows, _
            SearchDirection: = xlNext, MatchCase: = False ).Select
        If Err <>   0   Then   MsgBox   " Max value was not found: "   & MaxVal
    End Sub
12. 12. WarpText属性
    
    Sub ToggleWrapText()
        If   TypeName (Selection) =   " Range "   Then
          Selection.WrapText =   Not ActiveCell.WrapText
        End   If
    End Sub
    WarpText属性用于指示当前活动单元格是否被设置为允许换行。

返回目录

ActiveWorkbook

1. 1. 获取当前活动工作簿的名称
   Sub test()
       MsgBox ActiveWorkbook.FullName
   End Sub
2. 2. 打开工作表
   Sub filePath()
       Dim filePath As   String
       filePath = ActiveWorkbook.Path
       Workbooks.Open (filePath &   " \ "   &   " MyWorkbook.xls " )
   End Sub
3. 3. 保存工作表
   Sub webPage()
       ActiveWorkbook.SaveAs _
           Filename: = ActiveWorkbook.Path &   " \myXclfile.htm " , _
           FileFormat: = xlHtml
   End Sub
4. 4. 预览工作表
   Sub pre()
       ActiveWorkbook.WebPagePreview
   End Sub
5. 5. 发布Excel文件到指定的目录
   Public   Sub SaveRangeWeb()
       ActiveWorkbook.PublishObjects.Add _
           SourceType: = xlSourceRange, _
           Filename: = ActiveWorkbook.Path &   " \Sample1.htm " , _
           Sheet: = ActiveSheet.name, _
           Source: = " $A$1:$B$11 " , _
           HtmlType: = xlHtmlStatic
   
       ActiveWorkbook.PublishObjects( 1 ).Publish ( True )
       ActiveWorkbook.PublishObjects( 1 ).AutoRepublish ( False )
   End Sub
   上述代码可以将当前工作簿中所选择的区域以htm文件的格式发布到一个指定的目录中，该目录可以是本地目录，也可以是远程服务器上的目录，或者是Sharepoint中的一个特定的Folder。Publish方法的参数为True表示如果目标地址的文件存在则替换，为False表示如果目标地址的文件存在则追加。AutoRepublish方法的参数用于指示当Excel文件保存的时候是否自动重新发布。
   在Excel2007中，相当于点击窗体左上角的Office按钮，选择“发布”，点击“Document Management Server”，在弹出的对话框中选择相应的格式对文档进行发布操作。
6. 6. 遍历ActiveWorkbook中的表单集合
   Sub Test()
       For   Each Item In ActiveWorkbook.Sheets
           Debug.Print Item.name
       Next Item
   End Sub
7. 7. 关闭当前工作簿
   Sub close()
       ActiveWorkbook.Close SaveChanges: = False
   End Sub
   将当前工作簿关闭，SaveChanges为False表示不保存当前更改。
8. 8. 保护工作簿的结构和窗体
   Sub protect()
       ActiveWorkbook.Protect Password: = " pass " , Structure: = True , Windows: = True
   End Sub
   该操作相当于在Excel2007中，选择“Review”菜单，选择“Protect Workbook”，点击“Protect Structure and Windows”操作，该代码示例中给该操作设置了一个用于还原的密码。
9. 9. 打印工作表
   Sub print()
       ActiveWorkbook.Sheets( 1 ).Printout Copies: = 2 , Collate: = True
   End Sub
10. 10. 移除工作簿中的个人信息
    Sub remove()
        ActiveWorkbook.RemovePersonalInformation =   True
    End Sub
11. 11. 为工作簿设置打开密码
    Sub pass()
        ActiveWorkbook.Password =   " pass "
    End Sub
    该操作相当于在Excel2007中，点击“另存为”，在弹出的对话框中选择“工具”，点击“General Options...”，在弹出的对话框中设置用于打开工作簿的密码。
12. 12. 为工作簿设置可写密码
    Sub passWrite()
        ActiveWorkbook.WritePassword =   " pass "
    End Sub
    该操作相当于在Excel2007中，点击“另存为”，在弹出的对话框中选择“工具”，点击“General Options...”，在弹出的对话框中设置可修改工作簿的密码。
13. 13. 在当前工作簿中打开新窗口
    Sub   new ()
        ActiveWorkbook.Windows( 1 ).NewWindow
    End Sub
14. 14. 通过编程方式查找遍历工作簿当中的所有链接
    Sub PrintSimpleLinkInfo()
        Dim avLinks As Variant
        Dim nIndex As   Integer
        Dim wb As Workbook
        Set wb = ActiveWorkbook
        avLinks = wb.LinkSources(xlExcelLinks)
        If   Not   IsEmpty (avLinks) Then
            For nIndex =   1   To   UBound (avLinks)
                Debug.Print " Link found to ' "   & avLinks(nIndex) &   " ' "
            Next nIndex
        Else
            Debug.Print " The workbook ' "   & wb.name &   " ' doesn't have any links. "
        End   If
    End Sub
    xlLink为一组常量，代表了Excel工作簿中各种不同类型的链接。
    

    xlExcelLinks	指向Excel工作表。
    xlOLELinks	指向OLE数据源。
    xlPublishers	Macintosh使用。
    xlSubscribers	Macintosh使用。

15. 15. 工作簿常用属性使用
    Sub TestPrintGeneralWBInfo()
        Dim wb As Workbook
        Set wb = ActiveWorkbook
    
        Debug.Print " Name: "   & wb.name
        Debug.Print " Full Name: "   & wb.FullName
        Debug.Print " Code Name: "   & wb.CodeName
        Debug.Print " Path: "   & wb.Path
        If wb.ReadOnly Then
            Debug.Print " The workbook has been opened as read-only. "
        Else
            Debug.Print " The workbook is read-write. "
        End   If
        If wb.Saved Then
            Debug.Print " The workbook does not need to be saved. "
        Else
            Debug.Print " The workbook should be saved. "
        End   If
    End Sub

返回目录

ActiveWorksheet

1. 1. 改变当前工作表的名称
   Sub changeName()
       ActiveSheet.name =   " My Sheet "
   End Sub
2. 2. 向当前工作表添加超链接
   Public   Sub AddHyperlink()
       ActiveSheet.Hyperlinks.Add _
           Anchor: = Range( " A1 " ), _
           Address: = "" , _
           SubAddress: = " 'Sheet1'!A1 " , _
           ScreenTip: = " Goes to Sheet1 " , _
           TextToDisplay: = " Link to Sheet1 "
   End Sub
3. 3. 使用Copy和Paste方法
   Sub copy()
       Cells( 2 , " B " ).copy
       Range( " B2:B10 " ).Select
       ActiveSheet.Paste
   End Sub
   单元格拷贝时会同时拷贝该单元格的内容、格式以及公式等信息。
4. 4. 对工作表设置密码
   Sub protect()
       ActiveWorksheet.Protect Password: = " pass "
   End Sub
   Sub protects()
       ActiveWorksheet.Protect Password: = " pass " , AllowFormattingCells: = True , _
           AllowSorting: = True
   End Sub
5. 5. 设置工作表的DisplayPageBreaks属性
   Sub Main()
       ActiveSheet.DisplayPageBreaks =   False
       ActiveSheet.DisplayPageBreaks =   True
   End Sub
   DisplayPageBreaks属性用于指示是否显示工作表的分页符，如果没有安装打印机，则不能设置该属性的值。

返回目录

AdvancedFilter

1. 1. 使用AdvancedFilter
   Sub UniqueCustomerRedux()
       Range( " J1 " ).Value = Range( " D1 " ).Value
       Range( " A1 " ).CurrentRegion.AdvancedFilter xlFilterCopy, CopyToRange: = Range( " J1 " ), Unique: = True
   End Sub
   AdvancedFilter的使用类似于在Excel2007中“Data”菜单下“Sort&Filter”分类中的“Advanced”菜单的功能，其中xlFilterAction常量用于指定如何对数据进行Filter。

返回目录

AutoFill

1. 1. 使用AutoFill方法自动填充单元格
   Sub autoFill()
       Range( " F2:F13 " ).autoFill Destination: = Range( " F2:I11 " )
   End Sub
   用于从SourceRange填充数据到DestinationRange，可选参数xlAutoFillType常量用于指定填充数据的方式。数据填充过程中如果SourceRange和DestinationRange的Rows数目不一致会发生异常。

返回目录